(define-module (grump chem)
  #:use-module ((grump units si) #:select (g mol))
  #:use-module (oop goops)
  #:use-module (srfi srfi-71)
  #:export (molar-mass)
  #:export-syntax (define-element
                   define-elements
                   define-compound
                   define-compounds
                   define-mixture))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-class <element> ()
  (name          #:init-keyword #:name          #:getter name)
  (symbol        #:init-keyword #:symbol        #:getter symbol)
  (atomic-weight #:init-keyword #:atomic-weight #:getter atomic-weight))

(define-class <compound> ()
  (name     #:init-keyword #:name     #:getter name)
  (elements #:init-keyword #:elements #:getter elements))

(define-class <mixture> ()
  (name       #:init-keyword #:name       #:getter name)
  (fractions  #:init-keyword #:fractions  #:getter fractions)
  (components #:init-keyword #:components #:getter components))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-method (atomic-weight (c <compound>))
  (apply + (map atomic-weight (elements c))))

(define-method (atomic-weight (m <mixture>))
  (apply + (map (lambda (fraction component)
                  (* fraction (atomic-weight component)))
                (fractions m)
                (components m))))

(define molar-mass-constant
  (/ g mol))

(define (molar-mass x)
  (* molar-mass-constant (atomic-weight x)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define deal2 (@@ (grump units) deal2)) ; FIXME

(define-syntax define-element
  (lambda (x)
    (syntax-case x ()
      ((_ name symbol atomic-weight)
       #'(define name
           (make <element>
             #:name 'name
             #:symbol 'symbol
             #:atomic-weight atomic-weight))))))

(define-syntax define-elements
  (lambda (x)
    (syntax-case x ()
      ((_ (elements ...) ...)
       #`(begin
           #,@(map (lambda (element)
                     #`(define-element #,@element))
                   #'((elements ...) ...)))))))

(define-syntax define-compound
  (lambda (x)
    (syntax-case x ()
      ((_ name elements ...)
       #'(define name
           (make <compound>
             #:name 'name
             #:elements (list elements ...)))))))

(define-syntax define-compounds
  (lambda (x)
    (syntax-case x ()
      ((_ (compounds ...) ...)
       #`(begin
           #,@(map (lambda (compound)
                     #`(define-compound #,@compound))
                   #'((compounds ...) ...)))))))

(define-syntax define-mixture
  (lambda (x)
    (syntax-case x ()
      ((_ name (ppms components) ...)
       #'(define name
           (make <mixture>
             #:name 'name
             #:fractions (map (lambda (x)
                                (/ x 1000000))
                              '(ppms ...))
             #:components (list components ...)))))))
